/* GUI CONVERTED from rcctdelb.p (converter v1.76) Tue Jun 11 06:55:46 2002 */
/* rcctdelb.p - Subprogram to delete/archive unlinked container records       */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                        */
/* All rights reserved worldwide.  This is an unpublished work.               */
/* $Revision: 1.3 $                                                              */
/*                                                                            */
/*  Sub-program called when sub-levels are retained                           */
/*                                                                            */
/* $Revision: 1.3 $     BY:Manish K.        DATE:05/20/02 ECO: *P00C*            */
/*                                                                            */
/*V8:ConvertMode=Report                                                       */

/*GUI preprocessor directive settings */
&SCOPED-DEFINE PP_GUI_CONVERT_MODE REPORT

{mfdeclre.i}
{gplabel.i}

define input parameter i_site      like abs_site    no-undo.
define input parameter i_site1     like abs_site    no-undo.
define input parameter i_cont      like abs_id      no-undo.
define input parameter i_cont1     like abs_id      no-undo.
define input parameter i_cont_type like abs_type    no-undo.
define input parameter i_delete    like mfc_logical no-undo.
define input parameter i_filename  as   character   no-undo.

define stream s_history.

define variable v_id         like abs_id  label "Number" no-undo.
define variable level        as character label "Level"  no-undo.
define variable c_contlabel  as character format "x(13)" no-undo.
define variable c_origstruct as character format "x(24)" no-undo.
define variable c_subretain  as character format "x(24)" no-undo.

define temp-table t_abs1
   field t_abs_shipfrom1 like abs_shipfrom
   field t_abs_id1 like abs_id.

define temp-table t_abs2
   field t_abs_shipfrom2 like abs_shipfrom
   field t_abs_id2 like abs_id.

define temp-table t_abs3
   field t_abs_shipfrom3 like abs_shipfrom
   field t_abs_id3 like abs_id
   field t_abs_par_id3 like abs_par_id
   field t_abs__qad06  like abs__qad06.

define buffer ship_line for abs_mstr.

c_contlabel  = getTermLabelRtColon("CONTAINER",13).
c_origstruct = dynamic-function('getTermLabelFillCentered' in h-label,
                    input "ORIGINAL_STRUCTURE",
                    input 24,
                    input '*').
c_subretain = dynamic-function('getTermLabelFillCentered' in h-label,
                    input "SUBLEVELS_RETAINED",
                    input 24,
                    input '*').

FORM /*GUI*/ 
   level
   v_id
   space(3)
   abs_mstr.abs_item
   abs_mstr.abs_type
   abs_mstr.abs_qty format "->,>>>,>>9.9<<<<<<<<"
   pt_um
   abs_mstr.abs_site
   abs_mstr.abs_loc
   abs_mstr.abs_lotser
   abs_mstr.abs_ref
with STREAM-IO /*GUI*/  frame b down width 132 attr-space.

/* SET EXTERNAL LABELS */
setFrameLabels(frame b:handle).

/* FOR CONTAINER TYPE "S" OR "R" OR "U" */
if i_cont_type <> "" then do:
   for each ship_line where
      (ship_line.abs_shipfrom >= i_site and
       ship_line.abs_shipfrom <= i_site1) and
      (substring (ship_line.abs_id,2) >= i_cont and
       substring (ship_line.abs_id,2) <= i_cont1) and
      ship_line.abs_id begins "c"  and
      ship_line.abs_par_id = ""  and
      ship_line.abs_type = i_cont_type no-lock:

      for first pt_mstr
         fields (pt_part pt_um)
         where pt_part = ship_line.abs_item no-lock:
      end. /* FOR FIRST */

      display
         c_contlabel   at 15
         substring (ship_line.abs_id,2) at 30
         c_origstruct  at 47
      with frame qq no-label STREAM-IO /*GUI*/ .

      display
         "0"                  @ level
         ship_line.abs_id     @  v_id
         ship_line.abs_item   @ abs_mstr.abs_item
         ship_line.abs_type   @ abs_mstr.abs_type
         ship_line.abs_qty    @ abs_mstr.abs_qty
         if ship_line.abs__qad02 <> ""  then
            abs__qad02
         else
            if available pt_mstr then
               pt_um
            else
               ""
         @ pt_um
         ship_line.abs_site   @ abs_mstr.abs_site
         ship_line.abs_loc    @ abs_mstr.abs_loc
         ship_line.abs_lotser @ abs_mstr.abs_lotser
         ship_line.abs_ref    @ abs_mstr.abs_ref
      with frame b STREAM-IO /*GUI*/ .
      down 1 with frame b.

      run p_disp ( input 0, input abs_id , input abs_shipfrom).

      /* FIRST TEMP-TABLE TO DELETE UNLINKED PARENT CONTAINER */
      for each t_abs1 exclusive-lock:
         delete t_abs1.
      end.

      create t_abs1.
      assign
         t_abs1.t_abs_shipfrom1 = ship_line.abs_shipfrom
         t_abs1.t_abs_id1       = ship_line.abs_id.

      /* TEMP-TABLE TO CORRECTLY ADJUST ABS_PAR_ID */
      for each t_abs3 exclusive-lock:
         delete t_abs3.
      end.

      /* TEMP-TABLE TO DELETE THE ITEM RECORD */
      for each t_abs2 exclusive-lock:
        delete t_abs2.
      end.

      /* CHECK NEXT LEVEL WHETHER "C" OR "I" */
      run p_chk_nextlevel ( input ship_line.abs_id ,
                            input ship_line.abs_shipfrom).

      /* DISPLAY THE SUB-LEVELS RETAINED */
      run p_disp_sublevel.

      /* DELETE THE ABS_MSTR RECORDS */
      if i_delete then do:
         run p_delete1.
         run p_delete2.
      end. /* IF I_DELETE */

   end.   /* FOR EACH SHIP_LINE */

end. /* IF I_CONT_TYPE <> ""  */

/* FOR ALL TYPES OF CONTAINERS */
if i_cont_type =  "" then do:
   for each ship_line where
      (ship_line.abs_shipfrom >= i_site and
       ship_line.abs_shipfrom <= i_site1) and
      (substring (ship_line.abs_id,2) >= i_cont and
       substring (ship_line.abs_id,2) <= i_cont1) and
      ship_line.abs_id begins "c"  and
      ship_line.abs_par_id = ""  no-lock:

      for first pt_mstr
         fields (pt_part pt_um)
         where pt_part = ship_line.abs_item no-lock:
      end. /* FOR FIRST */

      display
         c_contlabel   at 15
         substring (ship_line.abs_id,2) at 30
         c_origstruct  at 47
      with frame qq1 no-label STREAM-IO /*GUI*/ .

      display
         "0" @ level
         ship_line.abs_id     @  v_id
         ship_line.abs_item   @ abs_mstr.abs_item
         ship_line.abs_type   @ abs_mstr.abs_type
         ship_line.abs_qty    @ abs_mstr.abs_qty
         if ship_line.abs__qad02 <> "" then
            abs__qad02
         else
            if available pt_mstr then
               pt_um
            else
               ""
         @ pt_um
         ship_line.abs_site   @ abs_mstr.abs_site
         ship_line.abs_loc    @ abs_mstr.abs_loc
         ship_line.abs_lotser @ abs_mstr.abs_lotser
         ship_line.abs_ref    @ abs_mstr.abs_ref
      with frame b STREAM-IO /*GUI*/ .
      down 1 with frame b.

      run p_disp (input 0, input abs_id , input abs_shipfrom).

      /* FIRST TEMP-TABLE TO DELETE UNLINKED PARENT CONTAINER */
      for each t_abs1 exclusive-lock:
         delete t_abs1.
      end.

      create t_abs1.
      assign
         t_abs1.t_abs_shipfrom1 = ship_line.abs_shipfrom
         t_abs1.t_abs_id1       = ship_line.abs_id.

      /* TEMP TABLE TO CORRECTLY ADJUST ABS_PAR_ID */
      for each t_abs3 exclusive-lock:
         delete t_abs3.
      end.

      /* TEMP TABLE TO DELETE THE ITEM RECORD */
      for each t_abs2 exclusive-lock:
        delete t_abs2.
      end.

      /* CHECK NEXT LEVEL WHETHER "C" OR "I" */
      run p_chk_nextlevel (input ship_line.abs_id,
                           input ship_line.abs_shipfrom).

      /* DISPLAY THE SUBLEVELS RETAINED */
      run p_disp_sublevel.

      /* DELETE THE ABS_MSTR RECORDS */
      if i_delete then do:
         run p_delete1.
         run p_delete2.
      end. /* IF I_DELETE */

   end.   /* FOR EACH SHIP_LINE */

end. /* IF I_CONT_TYPE = ""  */

PROCEDURE p_delete1:
   for each t_abs1:
      find first abs_mstr where abs_shipfrom = t_abs_shipfrom1
                            and abs_mstr.abs_id = t_abs_id1
                            exclusive-lock no-error.
      if available abs_mstr then do:
         if i_filename <> ""  then do:
            output stream s_history to value (i_filename) append.
            export stream s_history "abs_mstr".
            export stream s_history abs_mstr.
            output stream s_history close.
         end.
         delete abs_mstr.
      end. /* IF AVAILABLE ABS_MSTR */
   end. /* FOR EACH T_ABS1 */

END PROCEDURE. /* PROCEDURE P_DELETE1 */

PROCEDURE p_delete2:
   for each t_abs2:
      find first abs_mstr where abs_shipfrom = t_abs_shipfrom2
                            and abs_mstr.abs_id = t_abs_id2
                            exclusive-lock no-error.
      if available abs_mstr then do:
         if i_filename <> ""  then do:
            output stream s_history to value (i_filename) append.
            export stream s_history "abs_mstr".
            export stream s_history abs_mstr.
            output stream s_history close.
         end. /* IF I_FILENAME <>  ""  */
         delete abs_mstr.
      end. /* IF AVAILABLE ABS_MSTR */

   end.  /* FOR EACH T_ABS2 */

END PROCEDURE. /* PROCEDURE P_DELETE2 */

PROCEDURE p_update_child:

   for each t_abs3:
      find abs_mstr where abs_shipfrom = t_abs_shipfrom3
                    and   abs_id       = t_abs_id3
                    exclusive-lock no-error.
      if available abs_mstr then do:
         assign
            abs_mstr.abs_par_id = t_abs_par_id3
            abs_mstr.abs__qad06 =
                            string (integer (t_abs__qad06) - 1, "9").

         {gprun.i ""rcctwbu3.p""
                  "(input recid(abs_mstr))" }.
      end. /* IF AVAILABLE   */
   end.  /* FOR EACH T_ABS3 */

END PROCEDURE.  /* PROCEDURE P_UPDATE_CHILD */

PROCEDURE p_disp:
   define input parameter i_indent as integer no-undo.
   define input parameter l_abs_id like abs_id no-undo.
   define input parameter l_abs_shipfrom like abs_shipfrom no-undo.

   i_indent = i_indent + 1.
   for each abs_mstr where abs_shipfrom = l_abs_shipfrom
                       and abs_par_id = l_abs_id
                       and abs_id begins "i" no-lock:

      for first pt_mstr
         fields (pt_part pt_um)
         where pt_part = abs_mstr.abs_item no-lock:
      end. /* FOR FIRST */

      display
         fill (".",i_indent) + string (i_indent) @ level
         fill (".", i_indent) + "I" @ v_id
         abs_mstr.abs_item
         abs_mstr.abs_type
         abs_mstr.abs_qty
         if abs__qad02 <> "" then
            abs__qad02
         else
            if available pt_mstr then
               pt_um
            else
               ""
         @ pt_um
         abs_mstr.abs_site
         abs_mstr.abs_loc
         abs_mstr.abs_lotser
         abs_mstr.abs_ref
      with frame b STREAM-IO /*GUI*/ .
      down 1 with frame b.

   end. /* FOR EACH ABS_MSTR "I" */

   for each abs_mstr where abs_shipfrom = l_abs_shipfrom
                       and abs_par_id = l_abs_id
                       and abs_id begins "c" no-lock:
      for first pt_mstr
         fields (pt_part pt_um)
         where pt_part = abs_mstr.abs_item no-lock:
      end. /* FOR FIRST */
      display
         fill (".", i_indent) + string (i_indent) @ level
         fill (".", i_indent) + abs_id @ v_id
         abs_mstr.abs_item
         abs_mstr.abs_type
         abs_mstr.abs_qty
         if abs_mstr.abs__qad02 <> ""  then
            abs__qad02
         else
            if available pt_mstr then
               pt_um
            else
               ""
         @ pt_um
         abs_mstr.abs_site
         abs_mstr.abs_loc
         abs_mstr.abs_lotser
         abs_mstr.abs_ref
      with frame b STREAM-IO /*GUI*/ .
      down 1 with frame b.

      run p_disp (input i_indent , input abs_id , input abs_shipfrom).
   end. /* FOR EACH ABS_MSTR "C" */
END PROCEDURE. /* PROCEDURE P_DISP */


PROCEDURE p_chk_nextlevel:
   define input parameter l_abs_id like abs_id no-undo.
   define input parameter l_abs_shipfrom like abs_shipfrom no-undo.

      for each abs_mstr where abs_shipfrom = l_abs_shipfrom
                          and abs_par_id   = l_abs_id no-lock:
         if abs_mstr.abs_id begins "c"  then do:
            create t_abs3.
            assign
               t_abs3.t_abs_id3       = abs_mstr.abs_id
               t_abs3.t_abs_shipfrom3 = abs_mstr.abs_shipfrom
               t_abs3.t_abs_par_id3   = ""
               t_abs__qad06           = abs_mstr.abs__qad06.

            if i_delete then do:
               run p_update_child.
            end.   /* IF I_DELETE */

            next.
         end. /* IF ABS_MSTR.ABS_ID BEGINS "C" */

         if abs_mstr.abs_id begins "i" then do:
            create t_abs2.
            assign
               t_abs2.t_abs_shipfrom2 = abs_mstr.abs_shipfrom
               t_abs2.t_abs_id2       = abs_mstr.abs_id.
         end. /* IF ABS_MSTR.ABS_ID */

      end.  /* FOR EACH ABS_MSTR */

END PROCEDURE.   /* PROCEDURE P_CHK_NEXTLEVEL  */

PROCEDURE p_disp_sublevel:
   for each t_abs3:
      find first abs_mstr where abs_shipfrom = t_abs_shipfrom3
                            and abs_id       = t_abs_id3 no-lock no-error.
      if available abs_mstr then do:

         for first pt_mstr
            fields (pt_part pt_um)
            where pt_part = abs_mstr.abs_item no-lock:
         end. /* FOR FIRST */

         display
            c_subretain   at 47
            skip
         with frame xx no-label STREAM-IO /*GUI*/ .
      end.  /* IF AVAILABLE ABS_MSTR */

      display
         "0" @ level
         fill (".", 0) + if abs_mstr.abs_id begins "I" then "I"
         else abs_mstr.abs_id
         @ v_id
         abs_mstr.abs_item
         abs_mstr.abs_type
         abs_mstr.abs_qty
         if abs_mstr.abs__qad02 <> ""  then
            abs__qad02
         else
            if available pt_mstr then
               pt_um
           else
              ""
          @ pt_um
         abs_mstr.abs_site
         abs_mstr.abs_loc
         abs_mstr.abs_lotser
         abs_mstr.abs_ref
      with frame b down width 132 attr-space STREAM-IO /*GUI*/ .
      down 1 with frame b.

      run p_disp (input 0, input t_abs_id3, input t_abs_shipfrom3).

   end. /* FOR EACH T_ABS3 */

END PROCEDURE. /* PROCEDURE P_DISP_SUBLEVEL */
